home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / tptool.lbr / OS-CPM86.PQS / os-cpm86.pas
Pascal/Delphi Source File  |  1985-06-03  |  3KB  |  94 lines
  1.   { OS-CPM86.PAS }
  2.   { put all CP/M-86 specific code in this file }
  3.  
  4.  
  5.  { THIS CP/M-86 VERSION DOES NOT WORK PROPERLY, AND IS DISABLED }
  6.  { PROBLEM SEEMS TO BE IN SETTING THE DMA TO THE VARIABLE "dmabuf"  - wk }
  7.  
  8.  
  9.   procedure listcat;
  10.     { List file names on standard output; pasted together from OS-CPM80 and
  11.      OS-MSDOS  by W. Kempton. }
  12.     { version: January 1985 }
  13.  
  14.   const
  15.     maxfiles    = 256;
  16.     SearchFirst = 17;
  17.     SearchNext  = 18;
  18.  
  19.   var
  20.     i,j,k: integer;
  21.     dmabuf:  array [1..130] of byte;
  22.     DirBuf: array[1..maxfiles] of packed array [0..11] of char;
  23.     fcb : array[0..36] of byte;
  24.     name : XSTRING ;
  25.     kDB : integer;
  26.     Regs :
  27.     record
  28.       AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
  29.     end;
  30.  
  31.     Function Search(NameCount: integer): integer;
  32.      begin
  33.       if NameCount = 0
  34.        then Regs.CX := SearchFirst
  35.        else Regs.CX := SearchNext;
  36.       Regs.DX := ofs(fcb);
  37.       Regs.DS := Seg(fcb);
  38.       Bdos(Regs);
  39.       Search := Regs.AX and $FF ;
  40.      end { Search };
  41.  
  42.     procedure SetDMA(Segment, Offset: integer);
  43.      begin
  44.       Regs.CX := $001A;
  45.       Regs.DS := Segment;
  46.       Regs.DX := Offset;
  47.       Bdos(Regs);
  48.      end;
  49.  
  50.  
  51.    begin
  52.     if TRUE         { set FALSE to test this module }
  53.      then writeln('list: not yet implemented on CP/M-86')
  54.      else
  55.        begin
  56.         fcb[0] := 0;                             { set up file control block }
  57.         for i:=1 to 11 do fcb[i]:= ord('?');
  58.         for i:= 12 to 36 do fcb[i] := 0;
  59.         for i:= 1 to 130 do dmabuf[i] := 0;
  60.         SetDma(Seg(dmabuf),Ofs(dmabuf) );        { DMA set to local variable }
  61.         i := 0;
  62.         j := Search(i);
  63.         while (j < 255) and (i < maxfiles) do
  64.           begin
  65.            i := i + 1;
  66.            move (dmabuf[j*32 +1], DirBuf[i], 12);                { save name }
  67.            j := Search(i);      { search for next }
  68.           end;
  69.         { SetDma(  ????, $80);}                        { restore DMA address }
  70.         for j := 1 to i do                           { write names to STDOUT }
  71.           begin
  72.            k := 1;
  73.            while (k<9) and (DirBuf[j,k]<>' ') do
  74.              begin
  75.               name[k]:=ord(DirBuf[j,k]);  k:=k+1;
  76.              end;
  77.            if DirBuf[j,9] <> ' ' then
  78.               begin  { read from kDB, write to k }
  79.                kDB := 9;
  80.                name[k] := ord('.'); k := k+1;
  81.                repeat
  82.                  name[k] := ord(DirBuf[j,kDB]); k := k+1; kDB:=kDB+1;
  83.                until (kDB=12) or (DirBuf[j,kDB] = ' ');
  84.               end;
  85.            for i := 1 to (k-1) do
  86.             name[i] := name[i] mod 128; { clear attribute bits }
  87.            name[k] := ENDSTR;
  88.            PUTSTR(name,STDOUT);PUTC(NEWLINE); { use K&R, not WRITE/WRITELN }
  89.           end;
  90.        end;
  91.    end;
  92.  
  93.  
  94.